home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byt86oct.arc / ALLOC.ARC / ALLOC2.MOD < prev    next >
Text File  |  1985-07-12  |  5KB  |  185 lines

  1. IMPLEMENTATION MODULE Alloc2;
  2.  
  3. (* A storage allocator that tries to be safe about freed blocks.
  4.    It detects attempts to access freed blocks by leaving "tombstones"
  5.    in the heap.
  6.    Copyright 1986 by Jonathan Amsterdam.  All Rights Reserved. *)
  7.  
  8. FROM SYSTEM IMPORT WORD, ADDRESS, TSIZE;
  9. FROM MachineSpecific IMPORT getHeapBottom, getHeapTop, bytesPerWord,
  10.     address, cardinal, addrLessThan, writeAddress;
  11. FROM MyTerminal IMPORT fatal;
  12.  
  13. CONST maxIndex = 32767;
  14.  
  15. TYPE blockPtr = POINTER TO block;
  16.      block = RECORD
  17.          size:CARDINAL;  (* not including header *)
  18.          CASE BOOLEAN OF
  19.             TRUE: nextBlock: blockPtr;
  20.          |  FALSE: contents:ARRAY[0..maxIndex] OF WORD;
  21.          END;
  22.          END;
  23.  
  24. VAR heapBottom, heapTop:ADDRESS;
  25.     freeList:blockPtr;
  26.     blockHeaderSize, minBlockSize:CARDINAL;
  27.  
  28. PROCEDURE init;
  29. BEGIN
  30.     heapBottom := getHeapBottom();
  31.     heapTop := getHeapTop();
  32.     blockHeaderSize := TSIZE(CARDINAL);
  33.     minBlockSize := TSIZE(blockPtr) + blockHeaderSize;
  34.     freeList := blockPtr(heapBottom);
  35.     freeList^.size := 
  36.      (cardinal(heapTop-heapBottom) DIV bytesPerWord) - blockHeaderSize + 1;
  37.     freeList^.nextBlock := NIL;
  38. END init;
  39.  
  40. PROCEDURE blockSize(blockp:blockPtr):CARDINAL;
  41. BEGIN
  42.     RETURN blockp^.size;
  43. END blockSize;
  44.  
  45. PROCEDURE getWord(blockp:blockPtr; n:CARDINAL):WORD;
  46. BEGIN
  47.     tombstoneCheck(blockp);
  48.     IF n < blockp^.size THEN
  49.     RETURN blockp^.contents[n];
  50.     ELSE
  51.     fatal('getWord: out of bounds');
  52.     END;
  53. END getWord;
  54.  
  55. PROCEDURE setWord(blockp:blockPtr; n:CARDINAL; w:WORD);
  56. BEGIN
  57.     tombstoneCheck(blockp);
  58.     IF n < blockp^.size THEN
  59.     blockp^.contents[n] := w;
  60.     ELSE
  61.     fatal('setWord: out of bounds');
  62.     END;
  63. END setWord;
  64.  
  65. PROCEDURE allocate(nWords:CARDINAL):blockPtr;
  66. VAR currBlock, prevBlock:blockPtr;
  67. BEGIN
  68.     currBlock := freeList;
  69.     prevBlock := NIL;
  70.     WHILE currBlock <> NIL DO
  71.     IF nWords + minBlockSize < currBlock^.size THEN
  72.         (* split the block into two, returning the 2nd part *)
  73.         DEC(currBlock^.size, nWords+blockHeaderSize);
  74.         INC(currBlock, bytesPerWord*(blockHeaderSize + currBlock^.size)); 
  75.         currBlock^.size := nWords;
  76.         RETURN currBlock;
  77.     ELSIF nWords <= currBlock^.size THEN (* return the whole block *)
  78.         link(prevBlock, currBlock^.nextBlock);
  79.         RETURN currBlock;
  80.     END;
  81.     prevBlock := currBlock;
  82.     currBlock := currBlock^.nextBlock;
  83.     END;
  84.     RETURN NIL;
  85. END allocate;
  86.  
  87. PROCEDURE free(VAR freeBlock:blockPtr);
  88. VAR currBlock, prevBlock, temp:blockPtr; 
  89. BEGIN
  90.     IF NOT addrBetween(heapBottom, freeBlock, heapTop) THEN
  91.     fatal("free: block not in heap");
  92.     ELSIF freeBlock^.size = 0 THEN
  93.     fatal("free: attempt to free an already freed block");
  94.     ELSIF freeBlock^.size - blockHeaderSize < minBlockSize THEN
  95.     (* don't attempt to incorporate the block into the freelist *)
  96.     freeBlock^.size := 0;
  97.     freeBlock := NIL;
  98.     ELSE
  99.     temp := freeBlock;
  100.     INC(freeBlock, bytesPerWord*blockHeaderSize);
  101.     freeBlock^.size := temp^.size - blockHeaderSize;
  102.     temp^.size := 0;
  103.     currBlock := freeList;
  104.     prevBlock := NIL;
  105.     WHILE (currBlock <> NIL) AND addrLessThan(currBlock, freeBlock) DO
  106.         prevBlock := currBlock;
  107.         currBlock := currBlock^.nextBlock;
  108.     END;
  109.     IF currBlock = NIL THEN
  110.         freeBlock^.nextBlock := NIL;
  111.         link(prevBlock, freeBlock);
  112.     ELSE  (* freeBlock belongs just before currBlock *)
  113.         freeBlock^.nextBlock := currBlock;
  114.         link(prevBlock, freeBlock);
  115.     END;
  116.     tryToMerge(prevBlock, freeBlock, currBlock);
  117.     freeBlock := NIL;
  118.     END;
  119. END free;
  120.  
  121. PROCEDURE tryToMerge(lowBlock, middleBlock, highBlock:blockPtr);
  122. BEGIN
  123.     IF adjacent(middleBlock, highBlock) THEN
  124.     merge(middleBlock, highBlock);
  125.     END;
  126.     IF adjacent(lowBlock, middleBlock) THEN (* this should be impossible *)
  127.     merge(lowBlock, middleBlock);
  128.     END;
  129. END tryToMerge;
  130.  
  131. PROCEDURE adjacent(lowerBlock, higherBlock:blockPtr):BOOLEAN;
  132. BEGIN
  133.   RETURN 
  134.     (lowerBlock <> NIL) AND
  135.     (higherBlock <> NIL) AND
  136.     (lowerBlock + address(bytesPerWord*(lowerBlock^.size + blockHeaderSize)) = 
  137.        higherBlock);
  138. END adjacent;
  139.     
  140. PROCEDURE merge(lowerBlock, higherBlock:blockPtr);
  141. BEGIN
  142.     INC(lowerBlock^.size, higherBlock^.size + blockHeaderSize);
  143.     lowerBlock^.nextBlock := higherBlock^.nextBlock;
  144. END merge;
  145.     
  146. PROCEDURE link(prevBlock, linkBlock:blockPtr);
  147. BEGIN
  148.     IF prevBlock = NIL THEN
  149.     freeList := linkBlock;
  150.     ELSE
  151.     prevBlock^.nextBlock := linkBlock;
  152.     END;
  153. END link;
  154.  
  155. PROCEDURE addrBetween(low, middle, high:ADDRESS):BOOLEAN;
  156. BEGIN
  157.     RETURN (addrLessThan(low, middle) OR (low = middle)) AND
  158.        (addrLessThan(middle, high) OR (middle = high));
  159. END addrBetween;
  160.  
  161. PROCEDURE tombstoneCheck(blockp:blockPtr);
  162. BEGIN
  163.     IF blockp^.size = 0 THEN
  164.     fatal("attempt to access a freed block");
  165.     END;
  166. END tombstoneCheck;
  167.  
  168. PROCEDURE getFreeList():blockPtr;
  169. (* for debugging only *)
  170. BEGIN
  171.     RETURN freeList;
  172. END getFreeList;
  173.  
  174. BEGIN
  175.     init;
  176. END Alloc2.
  177. reeList():blockPtr;
  178. (* for debugging only *)
  179. BEGIN
  180.     RETURN freeList;
  181. END getFreeList;
  182.  
  183. BEGIN
  184.     init;
  185. END All